00100	TITLE PASS3
00200	EXTERNAL TRIBLKS,TRITAB,INPUT3,NUMTRI
00300	INTERNAL PASS3
00400	PASS3:	0
00500		SETZM NLEAST#	;COUNT OF TRIANGLES
00600	OPDEF OUTSTG [XWD 051140,0]
00700	;ACCUMULATORS
00800	A←←XY1←←KA←←0
00900	B←←XY2←←AC0←←LA←←1
01000	C←←XY3←←AC1←←2
01100	AA←←I1←←Z12←←LO←←LB←←KB←←3
01200	BB←←I2←←Z3I←←HI←←4
01300	CC←←I3←←C12←←MID←←5
01400	X1←←AB1←←6
01500	X2←←AB2←←7
01600	X3←←AB3←←10
01700	Y1←←AB←←11
01800	Y2←←CC3←←12
01900	Y3←←13
02000	Z1←←Z←←14
02100	Z2←←TRI←←15
02200	Z3←←LC←←16
02300	ZT←←QB←←II←←KK←←KC←←17
02400	KPLANE←1
     

00100	LOOP:	MOVE QB,NLEAST		;DONE YET  
00200		CAML QB,NUMTRI
00300		JRST @PASS3
00400	;BLIT TRIANGLE BLOCK INTO AC'S
00500		IMULI QB,5
00600		ADDI QB,INPUT3
00700		MOVSS QB
00800		BLT QB,4
00900	;UNPACK TRIANGLE BLOCK
01000		FOR @$ I←1,3 {
01100		HLRE X$I,XY$I
01200		HRRE Y$I,XY$I ⎇
01300		HLRE Z1,Z12
01400		HRRE Z2,Z12
01500		HLRE Z3,Z3I
01600		HRRZ II,Z3I
01700	P3B:
01800		TRNE II,4 ↔ SKIPA I1,[1] ↔ SETZ I1,
01900		TRNE II,2 ↔ SKIPA I2,[1] ↔ SETZ I2,
02000		TRNE II,1 ↔ SKIPA I3,[1] ↔ SETZ I3,
02100	P3A:
02200	;ORDER Z1 LEAST, Z3 MOST.
02300	DEFINE SWAP $ (N,M) {
02400	CAMG Z$N,Z$M
02500	JRST .+5
02600	EXCH X$N,X$M
02700	EXCH Y$N,Y$M
02800	EXCH Z$N,Z$M
02900	EXCH I$N,I$M ⎇
03000	SWAP 1,2
03100	SWAP 2,3
03200	SWAP 1,2
03300	
03400	MOVE II,I1	;RE-PACK I-BITS
03500	LSH  II,1
03600	IOR  II,I2
03700	LSH  II,1
03800	IOR  II,I3
03900	
04000	EXCH II,[KPLANE]
     

00100	;CALCULATE COEFFICIENTS OF THE PLANE OF THE TRIANGLE BY KRAMER'S RULE.
00200	DEFINE DET2B2 (A00,B11,B12,B21,B22) {
00300	MOVE B,B11
00400	MOVE C,B12
00500	IMUL B,B22
00600	IMUL C,B21
00700	SUB B,C
00800	IMUL B,A00 ⎇
00900	
01000	DEFINE DETERM (A11,A12,A13,A21,A22,A23,A31,A32,A33) {
01100	DET2B2 A11,A22,A23,A32,A33
01200	MOVE A,B
01300	DET2B2 A12,A21,A23,A31,A33
01400	SUB A,B
01500	DET2B2 A13,A21,A22,A31,A32
01600	ADD A,B ⎇
01700	
01800	DETERM KK,Y1,Z1,KK,Y2,Z2,KK,Y3,Z3
01900	MOVE AA,A
02000	DETERM X1,KK,Z1,X2,KK,Z2,X3,KK,Z3
02100	MOVE BB,A
02200	DETERM X1,Y1,KK,X2,Y2,KK,X3,Y3,KK
02300	MOVE CC,A
02400	DETERM X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
02500	MOVEM A,KSAVE#
02600	BRK:
03350	;HALFWORD OVERFLOW.
03500	DEFINE HALFOV (W,WW){
03600	MOVM W,WW
03700	CAIGE W,400000
03800	JRST .+10
03900	MOVE W,KSAVE	;OVERFLOW
03910	ASH W,-1
03920	MOVEM W,KSAVE
03930	ASH AA,-1
03940	ASH BB,-1
03950	ASH CC,-1
04350	JRST .-11
04400	⎇
04500	HALFOV A,AA
04600	HALFOV B,BB
04700	HALFOV C,CC
04800	P3C:
04900	;PACK PLANE COEFFICIENTS
05000	HRL BB,AA
05100	HRLS CC
05200	EXCH KK,[KPLANE]		;COL-1
     

00100	;CALCULATE LINE COEFFICIENTS
00200	DEFINE LINCOE (X1,X2,Y1,Y2,TA,TB,TC,X3,Y3) {
00300	MOVE TA,Y2
00400	MOVE TB,X1
00500	SUB TA,Y1	;(Y2-Y1)=a
00600	SUB TB,X2	;(X1-X2)=b
00700	HRL TC,TA
00800	HRR TC,TB
00900	IMUL TA,X1	; A*x1	
01000	IMUL TB,Y1	; B*y1
01100	ADD TA,TB
01200	MOVNS TA
01300	MOVM TB,TA
01400	CAIGE TB,400000
01500	JRST .+6
01600	HLRE TA,TC	;HALFWORD OVERFLOW CURE
01700	HRRE TB,TC
01800	ASH TA,-1
01900	ASH TB,-1
02000	JRST .-15	;JUMP TO THE  "HRL" ABOVE.
02100		;TA    c
02200		;TB    free
02300		;TC    a,,b
02400	;observe qqq sign convention  -  odd vertex positive.
02500		HLRE TB,TC
02600		IMUL TB,X3
02700		MOVEM TB,AC20
02800		HRRE TB,TC
02900		IMUL TB,Y3
03000		ADD TB,AC20
03100		ADD TB,TA
03200		JUMPGE TB,.+7
03300		MOVNS TA	;FLIP SIGN OF LINE COEFFICIENTS.
03400		HLRE TB,TC
03500		HRRE TC,TC
03600		MOVNS TB
03700		MOVNS TC
03800		HRL TC,TB
03900	⎇
04000	HRL QB,Z3
04100	LINCOE X1,X2,Y1,Y2,A,B,C,X3,Y3
04200	LINCOE X1,X3,Y1,Y3,LA,LB,LC,X2,Y2	;COL-2
04300	HRR CC,A	;PACK c3
04400	MOVEM KC,SAVKC#
04500	LINCOE X2,X3,Y2,Y3,KA,KB,KC,X1,Y1	;COL-4
04600	HRL Y1,X1
04700	MOVE X1,KC
04800	MOVE KC,SAVKC
     

00100	P3D:
00200	;PACK EVERYTHING INTO YOUR OLD KIT BAG AND SMILE SMILE SMILE
00300	; WOULD YOU BELIEVE A LONG TRIANGLE BLOCK   
00400	HRL Y2,X2
00500	HRL Y3,X3
00600	MOVE AB2,LC
00700	MOVE AB3,C
00800	MOVE 2,13
00900	HRL 1,0
01000	HRL 3,14
01100	HRR 3,15
01200	MOVE 0,11
01300	EXCH 1,12
01400	EXCH 5,12
01500	MOVE 11,4
01600	MOVE 4,17
01700	MOVE 13,KSAVE
01800	
01900	;BLIT BLOCK INTO LONG BLOCK TABLE.
02000	MOVE 17,NLEAST
02100	IMULI 17,14
02200	ADDI 17,TRIBLKS
02300	MOVE 16,17
02400	ADDI 16,13
02500	BLT 17,@16
     

00100	P3E:
00200	;PUT TRIANGLE BLOCK POINTER INTO THE TRIANGLE TABLE
00300	;IN ORDER ON MINIMUM DEPTH.
00400		HRL ZT,Z
00500		MOVE TRI,NUMTRI
00600		SKIPN LO,NLEAST
00700		JRST [AOS NLEAST		;FIRST TIME ONLY.
00800			MOVEM ZT,TRITAB-1(TRI)
00900			JRST LOOP]
01000		SETZ HI,
01100	PUT1:	MOVE MID,LO	;MID:=(LO+HI+1)/2
01200		ADD MID,HI
01300		AOS MID
01400		ASH MID,-1
01500		MOVE LC,TRI	;FETCH Z(MID)
01600		SUB LC,MID
01700		HLRE A,TRITAB(LC)
01800		CAML Z,A
01900		JRST [CAMN LO,MID
02000			JRST PUT2
02100			CAMN HI,MID
02200			JRST PUT2
02300			MOVE LO,MID
02400			JRST PUT1]
02500		CAMN LO,MID
02600		JRST [AOS MID
02700			JRST PUT2]
02800		CAMN HI,LO
02900		JRST [AOS MID
03000			JRST PUT2]
03100		MOVE HI,MID
03200		JRST PUT1
03400	;MOVE THE LOWER PART OF THE TRIANGLE TABLE,
03500	;BETWEEN NLEAST AND MID,
03600	;DOWN CORE BY ONE WORD.
03800	PUT2:	CAMLE MID,NLEAST
03900		JRST PUT3
04000		MOVEI AC0,TRITAB
04100		ADD AC0,TRI
04200		MOVE AC1,AC0
04300		SUB AC0,NLEAST
04400		HRLS AC0
04500		SOS AC0
04600		SUB AC1,MID
04700		SOS AC1
04800		BLT AC0,@AC1
04900	PUT3:	AOS NLEAST
05000		SUB TRI,MID
05100		MOVEM ZT,TRITAB(TRI)
05200		JRST LOOP
05300	AC20:	0
05400	END
     

00100	TITLE OCCULT
00200	EXTERNAL NUMTRI,OUTPDL,TRITAB,ENDPDL
00300	INTERNAL OCCULT
00400	OPDEF OUTSTR[XWD 5114,0]
00500	;USE AND ABUSE OF ACCUMULATORS
00600	AC0←←0
00700	AC1←←1
00800	XM←←0
00900	YM←←1
01000	
01100	XL←2		;The window.
01200	XH←3
01300	YL←4
01400	YH←5
01500	
01600	X1←AA←←6	;The triangle.
01700	X2←BB←←7
01800	X3←CC←←10
01900	
02000	Y1←MINZ←←11
02100	Y2←MAXZ←←12
02200	Y3←13
02300	
02400	AB←←14		;Plane coefficients.
02500	C←←15
02600	
02700	T←16
02800	TT←17
02900	KPLANE←20000
03000	
03100	XO←←14
03200	YO←←15
03300	PB←←17
03400	
03500	ODD←←13
03600	NEW←←14
03700	OLD←←15
03800	
03900	XY←←11
04000	X←←6
04100	Y←←7
04200	Z←←10
04300	EPTR←←14
04400	BPTR←←15
04500	CTB←←17
     

00100	;O.O.R. - Occult Object Remover.
00200	OCCULT:	0
00300		hrl TT,numtri		;Triangle pointer.
00400		movns TT	;This op covertly Subtracts one from left half.
00500		hrri TT,tritab-1
00600		movem TT,triptr#
00700	
00800		movni XL,1000		;first window
00900		movei XH,1000
01000		movni YL,1000
01100		movei YH,1000
01200		FOR W IN (PENOLD,PENNEW,SUR,SUR3,APEN,ASUR,ASUR3){
01300		SETZM W}
01400		movei 377777
01500		movem ZH#
01600		movei sqrpdl+1
01700		movem sqrpdl
01800		movei outpdl+1
01900		movem outpdl
02000		jrst .V
02100	;Occult Window Loop.
02200	OWLOOP:	sos 1,sqrpdl
02300		caig 1,sqrpdl
02400		jrst @occult	;no more windows.
02500	
02600		hlre XL,-5(1)	;new window
02700		hrre XH,-5(1)
02800		hlre YL,-4(1)
02900		hrre YH,-4(1)
03000	
03100		hrre -3(1)	;back limit.
03200		movem ZH
03300	
03400		move (1)	;triangle pointer
03500		movem triptr
03600	
03700		move -2(1)	;ancesters
03800		movem apen#
03900		move -1(1)
04000		movem asur#
04100		hlrz -3(1)
04200		movem asur3#
04300	
04400		setzm pennew#	;descendants
04500		setzm penold#
04600		setzm sur#
04700		setzm sur3#
04800	
04900		subi 1,5
05000		movem 1,sqrpdl
05100		jrst .V
     

00100	;Virgin  -  scan for first triangle.
00200	.V:	jsr pns
00300		jrst [	movem minz,penzlo#
00400			movem maxz,penzhi#
00500			movem T,pennew
00600			jrst .P]
00700		jrst owloop
00800		movem minz,surzlo#
00900		movem maxz,surzhi#
01000		hrlzm T,sur
01100	
01200	;One surrounder.
01300	.S:	jsr pns
01400		jrst [	caml minz,surzhi
01500			jrst .S			;B - penetrator is behind surrounder.
01600			movem T,pennew
01700			caml maxz,surzlo
01800			jrst %PS		;C - penetrator and surrounder conflict.
01900			movem minz,penzlo	;F - penetrator is in Front of surrounder
02000			movem maxz,penzhi
02100			jrst .SP]
02200		jrst alpha		;DISPLAY a surrounder.
02300		caml minz,surzhi
02400		jrst .S			;B - new surrounder is behind old surrounder.
02500		caml maxz,surzlo
02600		jrst [	movem minz,zlo#	;C - surrounders conflict.
02700			movem maxz,zhi#
02800			hrrm T,sur
02900			jrst .SS]
03000		movem minz,surzlo	;F - new surrounder is in front of old surrounder
03100		movem maxz,surzhi
03200		hrlm T,sur
03300		jrst .S
03400	
03500	;One Penetrator.
03600	.P:	jsr pns
03700		jrst [movem T,penold
03800		camle minz,penzhi
03900		jrst %PP		;B
04000		caml maxz,penzlo
04100		jrst .PP		;C
04200		jrst %PP]		;F
04300	
04400		jrst beta		;DISPLAY penetrator.
04500	
04600		movem minz,surzlo
04700		movem maxz,surzhi
04800		hrlzm T,sur
04900		caml minz,penzhi
05000		jrst .PS		;B
05100		caml maxz,penzlo
05200		jrst %PS		;C
05300		setzm pennew		;F
05400		jrst .S
05500	
05600	;Two surrounders.
05700	.SS:	jsr pns
05800		jrst [	caml minz,surzhi
05900			jrst .SS	;B
06000			caml minz,zhi	;F & C
06100			jrst .SS	;b
06200			movem T,pennew	;f & c
06300			jrst %PSS]
06400		jrst gamma		;DISPLAY two penetrators.
06500	
06600		caml minz,surzhi
06700		jrst .SS		;B
06800		caml maxz,surzlo
06900		jrst [	caml minz,zhi	;C
07000			jrst .SS	;b
07100			caml maxz,zlo
07200			jrst [	hrrzm T,sur3	;c
07300				jrst %SSS]
07400			hrrm T,sur
07500			movem minz,zlo
07600			movem maxz,zhi
07700			jrst .SS]
07800		caml minz,zhi
07900		jrst .SS
08000		caml maxz,zlo
08100		jrst [	hrlm T,sur	;c
08200			movem minz,surzlo
08300			movem maxz,surzhi
08400			jrst .SS]
08500		hrlzm T,sur		;f
08600		movem minz,surzlo
08700		movem maxz,surzhi
08800		jrst .S
08900	
     

00100	;A surrounder behind a penetrator.
00200	.PS:
00300	.SP:	jsr pns
00400		jrst [	caml minz,surzhi
00500			jrst .PS	;B
00600			movem T,penold
00700			caml maxz,surzlo
00800			jrst %PPS	;C
00900			camle minz,penzhi	;F
01000			jrst %PP	;b
01100			caml minz,penzlo
01200			jrst .PP	;c
01300			jrst %PP]	;f
01400		
01500		jrst beta		;DISPLAY.
01600	
01700		caml minz,surzhi
01800		jrst .PS		;B
01900		caml maxz,surzlo
02000		jrst [	hrrm T,sur	;C
02100			jrst %PSS]
02200		hrlm T,sur		;F
02300		movem minz,surzlo
02400		movem maxz,surzhi
02500		caml minz,penzhi
02600		jrst .PS		;B
02700		caml maxz,penzlo
02800		jrst %PS		;C
02900		setzm pennew		;F
03000		jrst .S
03100	
03200	
03300	SQRPDL:	.+1	;WINDOW SQUARE IN CORE PUSHDOWN LIST
03400		0	; XL XH
03500		0	; YL YH
03600		0	;sur3,,ZH
03700		0	; PEN1,,PEN2
03800		0	; SUR1,,SUR2
03900		0	; TRIPTR
04000	BITS←←=10	;NUMBER OF BITS OF DISPLAY RASTER.
04100		BLOCK (BITS*3+1)*6
04200	SQREND:
04300	FACES←←12	;CORNER PENETRATION DATA AREA
04400	CORPDL:	.+1
04500		BLOCK FACES
04600	PENPDL:	.+1
04700		BLOCK FACES
04800	CTBPTR:	.+1
04900		BLOCK FACES*13
     

00100	;Display output one-surrounder.
00200	alpha:	jrst owloop
00300	;DISPLAY OUTPUT ONE-PENETRATOR.
00400	BETA:	MOVE AC0,XH
00500		SUB  AC0,XL
00600		HRLM AC0,@OUTPDL
00700		MOVE AC1,PENNEW
00800		HRRM AC1,@OUTPDL
00900		AOS  OUTPDL
01000		HRLM XL,@OUTPDL
01100		HRRM YL,@OUTPDL
01200		AOS  OUTPDL
01300		JRST OWLOOP
01400	
01500	;DISPLAY OUTPUT TWO-SURROUNDERS
01600	GAMMA:	MOVE AC0,XH
01700		SUB  AC0,XL
01800		TRO  AC0,400000
01900		HRLM AC0,@OUTPDL
02000		HLRZ 1,SUR
02100		HRRM AC1,@OUTPDL
02200		AOS OUTPDL
02300		HRLM XL,@OUTPDL
02400		HRRM YL,@OUTPDL
02500		AOS  OUTPDL
02600		HRRZ 1,SUR
02700		HRRZM AC1,@OUTPDL
02800		AOS  OUTPDL
02900		JRST OWLOOP
03000	;Display two penetrators.
03100	EPSILON:
03200		MOVE XH
03300		SUB XL
03400		HRLM @OUTPDL
03500		MOVE 1,PENOLD
03600		HRRM @OUTPDL
03700		AOS OUTPDL
03800		HRLM XL,@OUTPDL
03900		HRRM YL,@OUTPDL
04000		AOS OUTPDL
04100		JRST BETA
     

00100	;OCCUPATION VOLUME
00200	
00300	;		Compute the occupation volume of the Triangle pointed
00400	;to by T for the window XL XH YL YH, find the minimum and maximum Z for all
00500	;corners of the window without exceeding the triangle's total volume z1
00600	;minimum to z3 maximum; if you are worth anything you have by now realized
00700	;that this will yield too large a volume for numerous penetrator cases
00800	;where the vertices aren't in the window and the corners aren't in the triangle
00900	;but it doesn't matter and will all come out correctly further along.
01000	
01100	OCCVOL:	0
01200		HLRE AA,11(T)		;PICKUP COEFFICIENTS OF TRIANGLE'S  PLANE.
01300		HRRE BB,11(T)
01400		HLRE CC,12(T)		
01500		SETCM T
01600		TLNE (5B2)	;IF EXTREME VERTICES ARE WITHIN...
01700		JRST .+4
01800		HLRE MINZ,3(T)	;THEN OCCUPATION VOLUME IS OBVIOUS.
01900		HLRE MAXZ,4(T)
02000		JRST @OCCVOL
02100		HRLZI MAXZ,400000	;Z1
02200		SETCAM MAXZ,MINZ	;Z3
02300	;calculte z-depth of window corners in the plane of the triangle.
02400	FOR I←0,3 
02500	{
02600		MOVEI AC0,KPLANE
02700		MOVE AC1,XL+(I∧1)
02800		IMUL AC1,AA
02900		SUB AC0,AC1
03000		MOVE AC1,YL+((I∧2)⊗-1)
03100		IMUL AC1,BB
03200		SUB AC0,AC1
03300		IDIV AC0,CC
03400		CAMGE AC0,MINZ
03500		MOVE MINZ,AC0
03600		CAMLE AC0,MAXZ
03700		MOVE MAXZ,AC0
03800	⎇
03900	;Clip window's projected volume to the extreme volume of the triangle.
04000		HLRE AC0,3(T)
04100		HLRE AC1,4(T)
04200		CAMLE AC0,MINZ
04300		MOVE MINZ,AC0
04400		CAMGE AC1,MAXZ
04500		MOVE MAXZ,AC1
04600	
04700	
04800	JRST @OCCVOL
     

00100	;P.O.S.  -  Penetrator, Outsider, Surrounder.
00200	pos:
00300	comment/ POS determines the relationship between a triangle and a window
00400		and skips respectively.  For penetrators it always calculates 
00500		vertex-within-bits,  For Pen & Surs it always calculates volume.
00600			Accumulators IN:   XL,XH,YL,YH, & T(right half).
00700		/
00800	
00900	;GET TRIANGLE'S COORDINATES INTO ACCUMULATORS.
01000	define gettac {
01100		hlre x1,0(T)
01200		hlre x2,1(T)
01300		hlre x3,2(T)
01400		hrre y1,0(T)
01500		hrre y2,1(T)
01600		hrre y3,2(T)
01700	}
01800		gettac
01900	
02000	;If all the corners of the triangle are to one side of the window,
02100	; then the triangle is Outside.
02200	
02300	define Outside $ (M,N,P,HL) {
02400		CAM$M P$HL,P$1  ↔  JRST .+5
02500		CAM$M P$HL,P$2  ↔  JRST .+3
02600		CAM$N P$HL,P$3  ↔  JRST pnsout 
02700	}
02800		Outside L,GE,X,H
02900		Outside L,GE,Y,H
03000		Outside G,LE,X,L
03100		Outside G,LE,Y,L
03200	
03300	
03400	;If any vertex of the Triangle is within the window,
03500	;	then it is a penetrator.
03600	
03700	For @$ N←1,3 {
03800			camle X$N,XH     ↔     jrst .+7
03900			camle XL,X$N     ↔     jrst .+5
04000			camle Y$N,YH     ↔     jrst .+3
04100			camg  YL,Y$N     ↔     ior T,[1⊗(=36-N)]
04200	}
04300	
04400		tlnn T,(7b2)
04500		jrst .+3
04600		jsr occvol		;Found a Penetrator.
04700		jrst @pns
04800	
04900	
     

00100	;SURROUNDS 
00200	
00300	comment/	For each edge of the triangle,  if for every corner of
00400		the window QQQ is the same sign then that edge does not pass 
00500		thru the window.  The odd vertex is in the opposite half plane
00600		from the window if the QQQs are all negative  -  which is
00700		equivalent to saying that the triangle is outside of the window.
00800		/
00900		jsr calq
01000		jrst pnsout		;OUTSIDE.
01100		tlne T,77770
01200		jrst [jsr occvol   ↔   jrst @pns]		;PENETRATOR.
01300		jsr occvol ↔ camge maxz,zh ↔ movem maxz,zh	;lower ZH - SURROUNDER.
01400		aos pns
01500		aos pns
01600		jrst @pns
01700	
01800	;P.N.S  -  Penetrator, Nil list, Surrounder.
01900	pns:	0
02000	;Get pointer to next triangle, if list is empty or triangle is
02100	;beyond the back limit then take the NIL exit.
02200	pnsout:	skipe T,asur			;Check for ancestors.
02300		jrst [hlrzs T			;left SUR 1.
02400		      jumpe T,[exch T,asur	;right SUR 2
02500			       jrst pnssur]
02600		      hrrzs asur
02700		      jrst pnssur]
02800		skipe T,asur3
02900		jrst [setzm asur3
03000		      jrst pnssur]
03100		skipe T,apen
03200		jrst [hlrzs T			;left PEN 1
03300		      jumpe T,[exch T,apen	;right pen 2
03400			       jrst pos]
03500		      hrrzs apen
03600		      jrst pos]
03700		move TT,Triptr
03800	beyond:	aobjp TT,[aos pns
03900			  jrst @pns]
04000		movem TT,Triptr
04100		hrrz T,(TT)
04200		hlre (TT)
04300		caml zh
04400		jrst @beyond		;beyond ZH.
04500		jrst pos
04600	pnssur:	jsr occvol ↔ camge maxz,zh ↔ movem maxz,zh	;lower Zh.
04700		aos pns			;surrounds
04800		aos pns
04900		jrst @pns
     

00100	;Calculate QQQ-bits, skip if not outside.
00200	calq:	0
00300			movsi PB,40000		;Select QQQ bit.
00400	define qqq (corner) {
00500			hlre ac1,AB
00600			hrre ac0,AB
00700			imul ac1,XL+ (corner ∧ 1)
00800			imul ac0,YL+((corner ∧ 2)⊗-1)
00900			add ac1,ac0
01000			add ac1,C
01100	}
01200	
01300	for  edge ← 1,3 {
01400			move AB,5+edge(T)	;Get line Coefficients
01500		IFE (edge-1),<hlre C,5(T)>
01600		IFE (edge-2),<hrre C,5(T)>
01700		IFE (edge-3),<hrre C,12(T)>
01800	for corner ← 0,3 {
01900		qqq corner
02000		skipge ac1		;Q sign convention - odd vertex positive.
02100		ior T,PB
02200		rot PB,-1
02300	}
02400	
02500		setcm ac1,T
02600		tlnn ac1,(17⊗(=33-edge*4))
02700		jrst @calq			;Triangle outside of window.
02800	}
02900		aos calq
03000		jrst @calq
     

00100	;Convert QQQ-bits into Pen-bits.
00200	CONQQQ:	0
00300	;Accumulators  IN:  XL,XH,YL,YH  (the window)
00400	;		    X1,X2,X3,Y1,Y2,Y3 (the triangle)
00500	;		    T (the triangle pointer)
00600	;Accumulators clobbered 0,1,14,15.
00700		tlne T,(7B2)	;If a vertex is within, then we must calQ.
00800		jrst [gettac	;get triangle's coordinates.
00900		      jsr calq
01000		      jfcl
01100		      jrst .+1]
01200	for @$ edge←1,3 {
01300	BP←←2+edge*4	;Bit pointer for testing.
01400	V ←←((7-edge)*edge)/2	;non-edge select bits.
01500		setcm T		;If both vertices within,
01600		tlne (V ⊗=33)
01700		jrst .+3
01800		tlz T,(17⊗(=35-BP))	;Then zero NSEW byte.
01900		jrst conq$edge
02000	
02100	;Convert 4-bit byte by table lookup.
02200		ldb ac1,[point 4,T,BP]
02300		move [ 0 ↔ 12 ↔ 11 ↔ 3 ↔  6 ↔ 14 ↔ 0 ↔  5
02400		       5 ↔  0 ↔ 14 ↔ 6 ↔  3 ↔ 11 ↔ 12 ↔ 0](ac1)
02500		
02600		tlne T,(V ⊗ =33)	;If both vertices without
02700		jrst .+3
02800		dpb [point 4,T,BP]
02900		jrst conq$edge	;Then we are done, Else:
03000	
03100	;Find vertex that is outside the window.
03200	selec1←←(IFE(1-edge),<1+>0)	;1,0,0 - first select.
03300	selec2←←(IFE(3-edge),<1+>1)	;2,2,1 - second select.
03400		tlne T,(1⊗(=35-selec1))
03500		;First selected bit is inside, hence second is outside.
03600		jrst [
03700		move XO,X1+selec2
03800		move YO,Y1+selec2
03900		jrst .+3]
04000	
04100		;First selected bit is outside.
04200		move XO,X1+selec1
04300		move YO,y1+selec1
04400	
04500	;Call one-crossing routine & you are done.
04600		jsr cross
04700		dpb [point 4,T,BP]
04800	conq$edge:
04900	}
05000	jrst @conqqq
     

00100	CROSS:	0
00200	
00300	comment /	The following tortured logic converts qqq-bits (which
00400		tell which half plane the window corners are in with respect
00500		to the lines determined by the triangle) into pen-bits (which 
00600		tell which sides of the window: North, South, East or West, each
00700		triangle edge segment crosses).
00800	
00900		Accumulators:  XO,YO & AC1.
01000		/
01100	
01200	;If the 2-bit is on
01300	trne 2  ↔  jrst [
01400	;then
01500	
01600		;If XO ≥ XH
01700		caml XO,XH  ↔  jrst [
01800		;Then 2-mask
01900			andi 2
02000			jrst @cross ]
02100		;Else 15-mask
02200			andi 15
02300			jrst @cross ]
02400	
02500	;Else
02600		;If 10-bit is on
02700		trne 10  ↔  jrst [
02800		;Then If YO ≥ YH
02900			caml YO,YH  ↔  jrst [
03000			;Then 10-mask
03100				andi 10
03200				jrst @cross]
03300			;Else 5-mask
03400				andi 5
03500				jrst @cross]
03600		;Else If XL > XO
03700			camle XL,XO  ↔ jrst [
03800			;Then 1-mask
03900				andi 1
04000				jrst @cross]
04100			;Else 4-mask
04200				andi 4
04300				jrst @cross
     

00100	;Two Penetrators.
00200	;Is an edge possible 
00300	;Do both pen have no vertices within 
00400	.pp:	move T,pennew
00500		tlne T,(7B2)
00600		jrst corn0
00700		move TT,penold
00800		tlne TT,(7B2)
00900		jrst corn0
01000	
01100	;Does ONLY ONE and the same edge intersect the window for each pen
01200	.PP1:
01300	define edgep $ (NNN)  {
01400		jsr conqqq	;convert q-bits into pen-bits.
01500		movei 1
01600		movem en$nnn
01700		ldb [point 4,T,6]
01800		jumpn [	ldb 1,[point 8,T,14]
01900			jumpn 1,%PP
02000			jrst .+6]
02100		aos en$nnn
02200		ldb [point 4,T,10]
02300		jumpn [ldb 1,[point 4,t,14]
02400			jumpn 1,%PP
02500			jrst .+3]
02600		aos en$nnn
02700		ldb [point 4,T,14]
02800		movem ep$nnn
02900		movem T,IFE(nnn-1),<pennew> IFE(nnn-2),<penold>
03000	}
03100		edgep 1
03200		move T,penold
03300		edgep 2
03400		move TT,T
03500		move T,pennew
03600		came ep1
03700		jrst %PP	;Penetration bits do not match.
     

00100	;Are the edges' endpoints identical 
00200	.PP2:	move 1,en1	;edge new's number.
00300		hrrz new,T	;pennew pointers
00400		hrl  new,T
00500		hrrz old,TT	;penold pointers
00600		hrl  old,TT
00700	add new,[0 ↔ xwd 1,2 ↔ xwd 0,2 ↔ xwd 0,1](1)
00800		move 1,en2
00900	add old,[0 ↔ xwd 1,2 ↔ xwd 0,2 ↔ xwd 0,1](1)
01000		move (new)
01100		came (old)
01200		jrst [movss old
01300		      came (old)
01400		      jrst %PP	;match failure
01500		      jrst .+1]
01600		movss new
01700		movss old
01800		move (new)
01900		came (old)
02000		jrst %PP	;match failure.
02100	
02200	;Are odd vertices in opposite half planes 
02300	.PP3:
02400	comment /	Let's do this one by picking up pennew's
02500		line-coefficients and penold's odd-vertex and multiplying
02600		them together in order to look at Q's sign./
02700	
02800	;Get line coefficients for edge-pennew  1.
02900		move 1,en1
03000	xct    [0
03100		hlre C,5(T)
03200		hrre C,5(T)
03300		hrre C,12(T)](1)
03400		add 1,T
03500		move AB,5(T)
03600	
03700	;Get odd-vertex for edge-penold 2; x y z.
03800	.PP4:	move odd,en2
03900	xct    [0
04000		hlre 3(TT)
04100		hrre 3(TT)
04200		hlre 4(TT)](odd)
04300		movem zodd#	;save odd z-depth value.
04400		add odd,TT
04500		move odd,-1(odd)	;odd's x,,y.
04600	
     

00100	;Calculate QQQ.
00200	.PP5:	hlre ac1,AB
00300		hlre ac0,odd
00400		imul ac1,ac0	; a*X + ...
00500		hrre ac0,AB
00600		hrre AB,odd
00700		imul ac0,AB	; b*Y + ...
00800		add ac1,ac0
00900		add ac1,C	; c = qqq
01000		jumpge ac1,EdOver	;Edge's penetrators overlap.
01100	;Coplanar & No intensity turned on edge 
01200		move 1,en1
01300		ldb ibpt(1)
01400		jumpn .PP7
01500		move 1,en2
01600		ldb ibptt(1)
01700		jumpn .PP7
01800		move 11(T)	;coplanar test.
01900		hllz 1,12(T)
02000		came 11(TT)
02100		jrst .PP7	;not coplanar.
02200		hllz 12(T)
02300		came 1,0
02400		jrst .PP7	;not coplanar.
02500	;Full Fledged Surrounder.
02600		move pennew
02700		hrlzm sur
02800		setzm pennew
02900		setzm penold
03000		move penzlo ↔ movem surzlo
03100		move penzhi ↔ movem surzhi
03200		camge ZH    ↔ movem ZH
03300		jrst .S
     

00100	;Final Edge Logic.
00200	.PP7:	camge minz,penzlo ↔ movem minz,penzlo
00300		camle maxz,penzhi ↔ movem maxz,penzhi
00400		move penzhi ↔ camge zh ↔ movem zh
00500				;pseudo-surrounder.
00600		move Triptr	;save pointer.
00700		movem Tpsav#
00800	.PP7a:	jsr pns
00900		jrst .PP8
01000		jrst epsilon
01100		skipe sur ↔ jrst [hrrm T,sur ↔ jrst .PP8]
01200		hrlzm T,sur
01300		caml minz,penzhi
01400		jrst .PP7a		;B
01500		caml maxz,penzlo
01600		jrst .PP8		;C
01700		setzm pennew		;F
01800		setzm penold
01900		movem minz,surzlo
02000		movem maxz,surzhi
02100		jrst .S
02200	;Final Edge Failure.
02300	.PP8:	move Tpsav
02400		movem Triptr
02500		jrst %PP
02600	;Edge Parametes
02700	en1:	0	;pennew's edge's number.
02800	en2:	0	;penold's edge's number.
02900	ep1:	0	;pennew's edge's pen-bits byte.
03000	ep2:	0	;penold's edge's pen-bits byte.
03100	;define intensity bit byte pointers.
03200	ibptt:	0
03300		point 1,4(TT),33
03400		point 1,4(TT),34
03500		point 1,4(TT),35
03600	ibpt:	0
03700		point 1,4(T),33
03800		point 1,4(T),34
03900		point 1,4(T),35
     

00100	;The two edge penetrators overlap,
00200	; that is the odd vertices are not in opposite halfplanes.
00300	EdOver:
00400	comment/	We shall determine which penetrator is hidden by finding
00500		out which is deeper from the window.
00600	
00700		Accumulators IN: AA,BB,CC which contain the plane coefficients
00800					  of pennew leftover from occvol.
00900				 & ODD  odd vertex of penold.
01000	
01100		Also remember that  AA*x + BB*y + CC*z = kplane.
01200		/
01300		movei ac0,kplane
01400		hlre ac1,odd
01500		imul ac1,AA
01600		sub ac0,ac1
01700		hrre ac1,odd
01800		imul ac1,BB
01900		sub ac0,ac1
02000		idiv ac0,CC
02100		camge ac0,zodd
02200	
02300	
02400	jrst [
02500	;Penold is hidden,  Pennew is a single penetrator.
02600		setzm penold ↔ movem minz,penzlo ↔ movem maxz,penzhi
02700		move 1,en2
02800		ldb ibptt(1)
02900		jumpe .P
03000		move 1,en1
03100		dpb ibpt(1)
03200	]
03300	
03400	;Pennew is hidden,  Penold is a single penetrator.
03500		move 1,en1
03600		ldb ibpt(1)
03700		jumpe .+3
03800		move 1,en2
03900		dpb ibptt(1)
04000		movem TT,pennew
04100		setzm penold
04200		jrst .P
     

00100	;CORNER RECOGNITON.
00200	;Do both pen have one and only and the same vertex within 
00300	corn0:	ldb 1,[point 3,T,2]
00400		caile 1,4
00500		jrst %PP
00600		cain 1,3
00700		jrst %PP
00800		jumpe 1,%PP
00900		move 1,[0 ↔ 3 ↔ 2 ↔ 0 ↔ 1](1)
01000		xct [0 ↔ hlre 3(T) ↔  hrre 3(T) ↔  hlre 4(T)](1)
01100		movem cornz#
01200		add 1,T
01300		move -1(1)
01400		movem cornxy#
01500		move TT,penold
01600		ldb 1,[point 3,TT,2]
01700		caile 1,4
01800		jrst %PP
01900		cain 1,3
02000		jrst %PP
02100		jumpe 1,%PP
02200		move 1,[0 ↔ 3 ↔ 2 ↔ 0 ↔ 1](1)
02300		add 1,TT
02400		move -1(1)
02500		came cornxy
02600		jrst %PP
02700	comment/	The above logic was in the hopes of a quick failure
02800		We are now confidant that a corner is extremely likely and 
02900		we are now willing to compute alittle harder in order to
03000		recognize it.	/
03100	;Initialize Corner Recognition Tables and Save Pointers.
03200	CORN00:	move Triptr
03300		movem TPsav
03400		camge minz,penzlo ↔ movem minz,penzlo	;common volume
03500		camge maxz,penzhi ↔ movem maxz,penzhi
03600		movei ctbptr+1
03700		movem ctbptr
03800		movei faces
03900		movnm face#
04000		setzm loose#
04100		setzm OLAP#
04200		movei penpdl+1
04300		movem penpdl
04400		movei corpdl+1
04500		movem corpdl
04600		jsr corner	;pennew
04700		move T,penold
04800		hlre AA,11(T)	;ad hoc pickup penold's plane coef.
04900		hrre BB,11(T)
05000		hlre CC,12(T)
05100		jsr corner	;penold
     

00100	;Main Loop of Corner Recognition.
00200	corn1:	jsr pns		;scan for next triangle
00300		jrst [  camge minz,penzlo ↔ movem minz,penzlo
00500			camle maxz,penzhi ↔ movem maxz,penzhi
00550			JSR CORNER
00600			jrst .-1]
00700		jrst theta	;sheet metal corner.
00800		skipe sur
00900		jrst [hrrm T,sur ↔ jrst .PP8]
01000		hrlzm T,sur
01100		caml minz,penzhi
01200		jrst corn1	;B
01300		caml maxz,penzlo
01400		jrst .PP8	;C
01500		setzm pennew	;F
01600		setzm penold
01700		movem minz,surzlo
01800		movem maxz,surzhi
01900		jrst .S
02000	;CORNER COMPLETION.
02100	corn2:	skipn OLAP
02200		jrst [move penzhi		;no overlap.
02300		camge ZH
02400		movem zH
02500		jrst .+1]
02600		jsr pns				;overlap occurred.
02700		jrst .PP8
02800		jrst corn3
02900		jrst .PP8
03000	corn3:	sos 1,penpdl			;pop penetrators.
03100		caig 1,penpdl
03200		jrst owloop
03300		sos corpdl			;pop corner
03400		skipge @corpdl
03500		jrst corn3			;overlapped are hidden.
03600		move XH ↔ sub XL ↔ hrlm @outpdl
03700		move 1,@penpdl ↔ hrrm 1,@outpdl   ↔ aos outpdl
03800		hrlm XL,@outpdl
03900		hrrm YL,@outpdl
04000		aos outpdl
04100		move CTB,@corpdl
04200		ldb @5(CTB)
04300		jumpn .+3
04400		ldb @6(CTB)
04500		dpb @5(CTB)
04600		ldb @7(CTB)
04700		jumpn corn3
04800		ldb @10(CTB)
04900		dpb @7(CTB)
05000		jrst corn3
05100	;sheet metal corners.
05200	Theta:	skipe OLAP ↔ 	halt ↔	jrst epsilon	;cheat.
     

00100	CORNER:	0
00200		aosle face
00300		jrst [outstr[asciz/More than 10 faces meeting at a corner - Warning.
00400	/] ↔ jrst .PP8]
00500		jsr TEST
00600		jsr FETCH
00700	
00800	
00900	
01000	define callap $ (A,C){	;Call overLAP.
01100		move XY,Ov$A$xy		;pickup out vertex's coordinates.
01200		move  X,Ov$A$x
01300		move  Y,Ov$A$y
01400		move Z,Ov$A$z
01500		move Bptr,ed$A$BP
01600		movei Eptr,C
01700		add Eptr,ctbptr
01800		jsr ovrlap
01900	}
02000	
02100	
02200	
02300		callap 1,3
02400		callap 2,7
02500		move ctbptr
02600		hrrm @corpdl	;put CTB pointer on corner pdl.
02700		aos corpdl
02800		addi 13
02900		movem ctbptr	;advance CTB pointer.
03000		jrst @corner
     

00100	TEST:	0
00200		move CTB,ctbptr
00300	;Corner test for eligibilty of penetrator.
00400		ldb 1,[point 3,T,2]
00500		caile 1,4
00600		jrst .PP8	;more than one vertex within window,
00700		cain 1,3
00800		jrst .PP8	;likewise.
00900		JUMPE 1,.PP8
01000		move 1,[0 ↔ 3 ↔ 2 ↔ 0 ↔ 1](1)
01100		movem 1,vertex#	;vertex is within window.
01200	;Does the vertex match the corner 
01300		add 1,T
01400		move -1(1)
01500		came cornxy
01600		jrst .PP8	;corner match failure,
01700		MOVE 1,VERTEX
01800	xct [0 ↔ hlre 3(T)
01900		 hrre 3(T)
02000		 hlre 4(T)](1)
02100		came cornz	
02200		jrst .PP8	;likewise
02300	
02400	;Put plane coef. into Corner table Block.
02500		movem AA,0(CTB)
02600		movem BB,1(CTB)
02700		movem CC,2(CTB)
02800	;Calculate window intersection bits.
02900		jsr conqqq
03000		move 1,vertex
03100		ldb [0↔POINT 4,T,6↔POINT 4,T,10↔POINT 4,T,14](1)
03200		jumpn .PP8	;Third edge of penetrator crosses window.
03300	;increment loose edge counter.
03400		aos loose
03500		aos loose
03600		jrst @TEST
03700	
     

00100	FETCH:	0
00200		MOVE CTB,CTBPTR
00300		movem t,@penpdl	↔ aos penpdl
00400		move 1,vertex
00500	;store the FIRST out-vertex's  x,y,z.
00600		caie 1,1
00700		jrst [	movem X1,ov1x#	;for in vertex 2 or 3
00800			movem Y1,ov1y#	; use triangle vertex 1.
00900			hlre 3(T)
01000			movem ov1z#
01100			jrst .+5]
01200		movem X2,ov1x		;for in vertex 1
01300		movem Y2,ov1y		; use triangle vertex 2
01400		hlre 3(T)
01500		movem ov1z
01600	;store the SECOND our-vertex's x,y,z.
01700		caie 1,3
01800		jrst [	movem X3,ov2x#	;for in vertex 1 or 2
01900			movem Y3,ov2y#	; use triangle vertex 3.
02000		hlre 4(T)
02100		movem ov2z#
02200		jrst .+5]
02300		movem X2,ov2x		;for in vertex 3
02400		movem Y2,ov2y		; use triangle vertex 2
02500		hrre 3(T)
02600		movem ov2z
02700	;store FIRST out-vertex's edge'S (which is the second-edge's)
02800	;	line-coefficients a,b,c   and intensity bit pointer
02900	;	into the second-edge of the CTB block.
03000	caie 1,1
03100	jrst [	move 6(T)	;for in vertex 2 or 3.
03200		movem 7(CTB)	; use triangle edge 1.
03300		hlrz 5(T)
03400		movem 10(CTB)
03500		hrrz T
03600		add [point 1,4,33]
03700		movem 11(CTB)
03800		movem ed2bp#
03900		jrst .+11]
04000		move 7(T)	;for in vertex 1
04100		movem 7(CTB)	; use triangle edge 2.
04200		hrrz 5(T)
04300		movem 10(CTB)
04400		hrrz T
04500		add [point 1,4,34]
04600		movem 11(CTB)
04700		movem ed2bp
     

00100	;store SECOND out-vertex's edge's (which is the first-edge's)
00200	;	line-coefficients a,b,c   and intensity bit pointer
00300	;	into the first-edge of the CTB block.
00400	caie 1,3
00500	jrst [	move 10(T)	;for in vertex 1 or 2.
00600		movem 3(CTB)	; use triangle edge 3.
00700		hrrz 12(T)
00800		movem 4(CTB)
00900		hrrz T
01000		add [point 1,4,35]
01100		movem 5(CTB)
01200		movem ed1bp#
01300		jrst .+11]
01400		move 7(T)	;for in vertex 3
01500		movem 3(CTB)	; use triangle edge 2.
01600		hrrz 5(T)
01700		movem 4(CTB)
01800		hrrz T
01900		add [point 1,4,34]
02000		movem 5(CTB)
02100		movem ed1bp
02200		move ov1x
02300		hrl ov1y
02400		movsm ov1xy#
02500		movsm 6(CTB)
02600		move ov2x
02700		hrl ov2y
02800		movsm ov2xy#
02900		movsm 12(CTB)
03000		move ov1z
03100		hrlm 4(CTB)
03200		move ov2z
03300		hrlm 10(CTB)
03400		jrst @FETCH
     

00100	;Record overlaps and link loose edges.
00200	OVRLAP:	0
00300	
00400	
00500	
00600	
00700	define LINK $ (M) {
00800	;do x,,y & z match 
00900		hlre M+1(CTB)
01000		came Z
01100		jrst link$M
01200		came XY,M+3(CTB)
01300		jrst link$M
01400	;found a link.
01500		movem Bptr,M+3(CTB)	;put my IBP in his block.
01600		move M+2(CTB)		;put his IBP in my block.
01700		movem 3(Eptr)
01800		move ctbptr		;put my CTB in his link.
01900		hrlm M+1(CTB)
02000		hrlm CTB,1(Eptr)	;Put his CTB in my link.
02100		sosn loose	;decrement loose edge's counter.
02200		jrst CORN2	;corner completion.
02300		jrst @OVRLAP	;overlap/link scan completed.
02400	link$M:		}
02500	
02600	
02700	
02800	
02900	define ovqqq (nm) {		;compute QQQ
03000		hlre nm(CTB)
03100		imul X
03200		hrre 1,nm(CTB)
03300		imul 1,Y
03400		add 1
03500		hrre 1,nm+1(CTB)
03600		add 1
03700		jumpe [link nm↔ jrst .+2]
03800		jumpl ovrloop	}
     

00100		movei corpdl+1
00200		movem pdlptr#
00300		movei CTB,ctbptr+1
00400	LAPLOOP:	caml CTB,ctbptr
00500		jrst @ovrlap
00600		ovqqq 3
00700		ovqqq 7
00800	;some one is overlapped.
00900		setom OLAP	;overlapped switch
01000		movei kplane
01100		move 1,(CTB)
01200		imul 1,X
01300		sub 1
01400		move 1,1(CTB)
01500		imul 1,Y
01600		sub 1
01700		idiv 2(CTB)
01800		camg Z,
01900		jrst [hrros @pdlptr	;he has been overlapped.
02000		      jrst .+2    ]
02100		hrros @corpdl
02200	ovrloop:	addi CTB,13 ↔	aos pdlptr ↔	jrst LAPLOOP
     

00100	;Save Father's surrounders  &  penetrators  and EXIT.
00200	%SSS: ↔ %PSS: ↔ %PPS: ↔ %PP: ↔ %PS:
00300		move 11,ZH
00400		hrl 11,sur3
00500		move 12,penold
00600		hrl 12,pennew
00700		move 13,sur
00800		move 14,triptr
00900	;Split up the window,  Recursion Exit.
01000	rexit:	move XM,XL
01100		move YM,YL
01200		add XM,XH
01300		add YM,YH
01400		ash XM,-1
01500		ash YM,-1
01600		camn XL,XM	;resolution 
01700		jrst owloop
01800		camn XH,XM
01900		jrst owloop
02000		move 6,sqrpdl	;setup blit pointer
02100		hrli 6,7
02200		move 15,6
02300		move 16,6
02400		move 17,6
02500		addi 16,6
02600		addi 17,14
02700		move  7,XH	;lower-right-window
02800		move 10,YM
02900		hrl   7,XM
03000		hrl  10,YL
03100		blt  15,5(6)
03200		movss 7		;lower-left-window
03300		hrl   7,XL
03400		blt  16,13(6)
03500		movss 10	;upper-left-window
03600		hrr   10,YH
03700		blt   17,21(6)
03800		addi   6,22
03900		movem  6,sqrpdl	;update pdl pointer.
04000	;initialize OWL loop for upper-right window.
04100		move XL,XM
04200		move YL,YM
04300		movem 12,apen		;anscestors.
04400		movem 13,asur
04500		hlrzm 11,asur3
04600		setzm penold		;descendants.
04700		setzm pennew
04800		setzm sur
04900		setzm sur3
05000		jrst .V
05100	END
     

00100	TITLE DATA
00200	INTERNAL NUMTRI,TRIBLKS,TRITAB,INPUT3,INPUT6,FFLAG,INPUT5,OUTPDL
00300	INTERNAL  ENDPDL,END6
00400	NUMTRI:	20
00500	TRIBLKS:	0
00600	BLOCK 400
00700	TRITAB:	0
00800	BLOCK 40
00900	INPUT3:
01000	DEFINE TRIANG (X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,N)
01100	{
01200	XWD X1,Y1
01300	XWD X2,Y2
01400	XWD X3,Y3
01500	XWD Z1,Z2
01600	XWD Z3,N
01700	⎇
01800	
01900	DEFINE QUAD (X1,Y1,X2,Y2,Z12,X3,Y3,X4,Y4,Z34)
02000	{
02100	TRIANG X1,Y1,Z12,X2,Y2,Z12,X3,Y3,Z34,5
02200	TRIANG X1,Y1,Z12,X3,Y3,Z34,X4,Y4,Z34,6
02300	⎇
02400	
02500	QUAD -500,-700,-500,-200, 200, 440,-200, 440,-700,200
02600	QUAD -440,-100,-440, 200, 600, 300, -40,300,-600, 100
02700	QUAD 0,100,0,500,100,440,500,440,100,100
02800	QUAD -440,400,-440,700,600,-240,700,-240,400,600
02900	QUAD 0,500,440,500,100,-240,700,-440,700,600
03000	QUAD 0,100,440,100,100,-240,400,-440,400,600
03100	QUAD 440,100,440,500,100,-240,700,-240,400,600
03200	QUAD 0,100,0,500,100,-440,700,-440,400,600
03205	
03210	FFLAG:	-1	;FRAME FLAG
03215	OUTPDL:	.+3
03220		
03225	INPUT5:	XWD 1200,INPUT3
03230		XWD -500,-500
03235		BLOCK 14000
03236	ENDPDL:	0	↔	0	↔	0	↔	0
03240	INPUT6:	0
03260	BLOCK 40000
03261	END6:	0 ↔ 0 ↔ 0 ↔ 0
03300	END